home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / MAILUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  30KB  |  958 lines
  1. UNIT MailUtil;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Misc. routines used in a WaZOO session        Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, Dos, PopTypes;
  16.  
  17. VAR
  18.   Hello, RemHello : THelloPacket;
  19.   HelloByte      : ARRAY[1..128] OF Byte ABSOLUTE Hello;
  20.   RemHelloByte   : ARRAY[1..128] OF Byte ABSOLUTE RemHello;
  21.  
  22. CONST
  23.   ExtFlags       : String[5] = 'HDFCI';
  24.   DeleteAfter     = '-';
  25.   ShowDeleteAfter = '^';
  26.   TruncAfter      = '#';
  27.   NothingAfter    = '@';
  28.   NothingAfterRefuse = '?' ;
  29.  
  30. VAR
  31.   NetProblems    : Byte;
  32.  
  33. FUNCTION  ReqOk: Boolean;
  34. FUNCTION  IsOurAddress(CONST Adr: TFidoAddress): Boolean;
  35. FUNCTION  ProductNames(Num: Word): S30;
  36. FUNCTION  NoAll(CONST Adr: TFidoAddress): BOOLEAN;
  37. FUNCTION  Address2Sort(CONST Address: TFidoAddress): S8;
  38. PROCEDURE RemapAddress(VAR Adr: TFidoAddress);
  39. FUNCTION  CmpAdr(CONST a1, a2: TFidoAddress): Boolean;
  40. FUNCTION  GetAdressFromStr(s: String; VAR Address: TFidoAddress) : BOOLEAN;
  41.  
  42. PROCEDURE FindUnDialable(CONST InAddress: TFidoAddress; VAR NC, BWZ: Word);
  43. PROCEDURE RemoveUnDialable(CONST InAddress: TFidoAddress);
  44. PROCEDURE UpdateUnDialable(CONST InAddress: TFidoAddress; NC, BWZ: Word);
  45.  
  46. PROCEDURE DisposeNodesIdx;
  47. FUNCTION  FindNodeInfo(VAR n: TNodeInfo; CONST Address: TFidoAddress): Boolean;
  48. PROCEDURE PutNodeInfo(VAR n: TNodeInfo);
  49. FUNCTION  FindPointNet(VAR n: TNodeInfo; InPointNet: Integer): Boolean;
  50.  
  51. FUNCTION  HoldAreaNameMunge(Zone: Integer; Create: Boolean): PathStr;
  52. FUNCTION  HoldAreaPath(CONST Adr: TFidoAddress; Create: Boolean): PathStr;
  53. FUNCTION  HoldFileName(CONST Adr: TFidoAddress; Create: Boolean): PathStr;
  54. FUNCTION  InventPktName: PathStr;
  55. FUNCTION  MakeReqFileName(Net, Node: Integer; NodeStat: TNodeStat): PathStr;
  56.  
  57. FUNCTION  MarkNodeBusy(VAR f: File; CONST Adr: TFidoAddress): Boolean;
  58. PROCEDURE UnMarkNodeBusy(VAR f: File);
  59.  
  60. PROCEDURE FindSuckerInfo(CONST Adr: TFidoAddress; VAR DRI: TDailyReqInfo);
  61. PROCEDURE WriteSuckerInfo(DRI: TDailyReqInfo);
  62.  
  63. PROCEDURE GetPktHeadInfo(CONST PH: TPktHeader; Var Orig,Dest: TFidoAddress);
  64. PROCEDURE FillOutPktHeader(CONST Orig,Dest : TFidoAddress; Var PH : TPktHeader);
  65. FUNCTION  KludgeLines(CONST Orig,Dest: TFidoAddress):STRING;
  66.  
  67. IMPLEMENTATION
  68.  
  69. USES OpString, OpDate, OpRoot,
  70.      LogFile, FileUtil, StrUtil, NetFile, Nodelist, SimpDB, MailCfg, Util, Globals;
  71.  
  72.   FUNCTION ReqOk: Boolean;
  73.   BEGIN
  74.     ReqOk:=NOT isCaller OR ((Cfg.Request.ReqOnUs=ru_Always) OR
  75.     ((Cfg.Request.ReqOnUs=ru_Cost) AND (FoundInNL) AND (NodelistEntry.Cost<=Cfg.Request.ReqOnUsCost)));
  76.   END;
  77.  
  78.   FUNCTION KludgeLines(CONST Orig,Dest: TFidoAddress):STRING;
  79.   VAR
  80.     s:STRING;
  81.   BEGIN
  82.     s:=#1'INTL '+Long2Str(Dest.Zone)+':'+Long2Str(Dest.Net)+'/'+Long2Str(Dest.Node)+' '+
  83.                  Long2Str(Orig.Zone)+':'+Long2Str(Orig.Net)+'/'+Long2Str(Orig.Node);
  84.     IF Orig.Point<>0 THEN s:=s+#13#10#1'FMPT '+Long2Str(Orig.Point);
  85.     IF Dest.Point<>0 THEN s:=s+#13#10#1'TOPT '+Long2Str(Dest.Point);
  86.     s:=s+#13#10#1'PID: PoP '+Ver;
  87.     KludgeLines:=s;
  88.   END;
  89.  
  90.   PROCEDURE FillOutPktHeader(CONST Orig,Dest : TFidoAddress; Var PH : TPktHeader);
  91.   VAR
  92.     i : Word;
  93. {$IFDEF OS2}
  94.     D, M, Y,
  95.     H, Mi, S: Word;
  96. {$ENDIF}
  97.   BEGIN
  98.     FillChar(ph,Sizeof(TPktHeader),#0);
  99.     with ph do
  100.     BEGIN
  101.       Filler1:=2;
  102.       IF FindNodeInfo(NodesRec,Dest) THEN Str2AsciiZ(NodesRec.PktPassWord,PassWord,7);
  103.       OrigNode:=Orig.Node;
  104.       DestNode:=Dest.Node;
  105. {$IFDEF OS2}
  106.       GetDate(Y,M,D,i);
  107.       GetTime(H,Mi,S,i);
  108.       Year:=Y; Month:=M; Day:=D;
  109.       Hour:=H; Min:=Mi; Sec:=S;
  110. {$ELSE}
  111.       GetDate(Word(Year),Word(Month),Word(Day),i);
  112.       GetTime(Word(Hour),Word(Min),Word(Sec),i);
  113. {$ENDIF}
  114.       OrigNet:=Orig.Net;
  115.       DestNet:=Dest.Net;
  116.       Product:=PopProductCode;
  117.       OrigZone:=Orig.Zone;
  118.       DestZone:=Dest.Zone;
  119.       OrigZone2:=Orig.Zone;
  120.       DestZone2:=Dest.Zone;
  121.       OrigPoint:=Orig.Point;
  122.       DestPoint:=Dest.Point;
  123.       Capabil:=1;
  124.       CWValHigh:=1;
  125.       if Orig.Point <>0 then
  126.       BEGIN
  127.         AuxNet:=Orig.Net;
  128.         OrigNet:=-1;
  129.       END;
  130.     END;
  131.   END;
  132.  
  133.   PROCEDURE GetPktHeadInfo(CONST PH: TPktHeader; Var Orig,Dest : TFidoAddress);
  134.   Begin
  135.     FillChar(Orig,Sizeof(TFidoAddress),#0);
  136.     FillChar(Dest,Sizeof(TFidoAddress),#0);
  137.     With PH do
  138.     Begin
  139.       Orig.Zone:=OrigZone;
  140.       Orig.Net:=Orignet;
  141.       Orig.node:=orignode;
  142.       Dest.Zone:=DestZone;
  143.       Dest.Net:=DestNet;
  144.       Dest.Node:=destNode;
  145.       if (CWValHigh=LO(CapaBil)) AND (CWValLow=HI(CapaBil)) AND
  146.          (CWValHigh and 1 <>0) and (CapaBil and 1 <>0) then
  147.       BEGIN
  148.         if (OrigPoint <> 0) {and (OrigNet=-1)} then
  149.         BEGIN
  150.           Orig.Net:=AuxNet;
  151.           Orig.Point:=OrigPoint;
  152.         END;
  153.         Dest.Point:=DestPoint;
  154.         Orig.Zone:=OrigZone2;
  155.         Dest.Zone:=DestZone2;
  156.       END;
  157.     end;
  158.   end;
  159.  
  160.   FUNCTION IsOurAddress(CONST Adr: TFidoAddress): Boolean;
  161.   VAR
  162.     Found : Boolean;
  163.     i     : Byte;
  164.   BEGIN
  165.     Found:=False;
  166.     IF Cfg.Addresses[Cfg.MainAdrNum].Point<>0 THEN
  167.     BEGIN
  168.       IF (Adr.Point=0) AND (Adr.Net=Cfg.PointNet) AND
  169.          (Adr.Node=Cfg.Addresses[Cfg.MainAdrNum].Point) THEN Found:=TRUE;
  170.     END;
  171.     IF NOT Found THEN
  172.       FOR i:=1 TO MaxAddresses DO
  173.         IF CmpAdr(Adr,Cfg.Addresses[i]) THEN
  174.         BEGIN
  175.           Found:=True;
  176.           Break;
  177.         END;
  178.     IsOurAddress:=Found;
  179.   END;
  180.  
  181. {----------------------------------------------------------------------------}
  182. { FidoNet Productcodes                                                       }
  183. {----------------------------------------------------------------------------}
  184.   FUNCTION ProductNames(Num: Word) : S30;
  185.   BEGIN
  186.     CASE Num Of
  187.       0 : ProductNames:='Fido';
  188.       1 : ProductNames:='Rover';
  189.       2 : ProductNames:='SEAdog';
  190.       3 : ProductNames:='WinDog';
  191.       4 : ProductNames:='Slick/150';
  192.       5 : ProductNames:='Opus';
  193.       6 : ProductNames:='Dutchie';
  194.       8 : ProductNames:='Tabby';
  195.      10 : ProductNames:='Wolf/68k';
  196.      11 : ProductNames:='QMM';
  197.      12 : ProductNames:='FrontDoor';
  198.      17 : ProductNames:='MailMan';
  199.      18 : ProductNames:='OOPS';
  200.      19 : ProductNames:='GS-Point';
  201.      20 : ProductNames:='BGMail';
  202.      25 : ProductNames:='BinkScan';
  203.      26 : ProductNames:='D''Bridge';
  204.      27 : ProductNames:='BinkleyTerm';
  205.      28 : ProductNames:='Yankee';
  206.      7,9,
  207.      13..16,
  208.      21..24,
  209.      29,
  210.      132: ProductNames:='Dropped ('+Long2Str(Num)+')';
  211.      30 : ProductNames:='Daisy';
  212.      31 : ProductNames:='Polar Bear';
  213.      32 : ProductNames:='The-Box';
  214.      33 : ProductNames:='STARgate/2';
  215.      34 : ProductNames:='TMail';
  216.      35 : ProductNames:='TCOMMail';
  217.      36 : ProductNames:='Bananna';
  218.      37 : ProductNames:='RBBSMail';
  219.      38 : ProductNames:='Apple-Netmail';
  220.      39 : ProductNames:='Chameleon';
  221.      40 : ProductNames:='Majik Board';
  222.      41 : ProductNames:='QMail';
  223.      42 : ProductNames:='Point And Click';
  224.      43 : ProductNames:='Aurora';
  225.      44 : ProductNames:='FourDog';
  226.      45 : ProductNames:='MSG-PACK';
  227.      46 : ProductNames:='AMAX';
  228.      47 : ProductNames:='Domain Communication System';
  229.      48 : ProductNames:='LesRobot';
  230.      49 : ProductNames:='Rose';
  231.      50 : ProductNames:='Paragon';
  232.      51 : ProductNames:='BinkleyTerm/oMMM/ST';
  233.      52 : ProductNames:='StarNet';
  234.      53 : ProductNames:='ZzyZx';
  235.      54 : ProductNames:='QuickBBS';
  236.      55 : ProductNames:='BOOM';
  237.      56 : ProductNames:='PBBS';
  238.      57 : ProductNames:='TrapDoor';
  239.      58 : ProductNames:='Welmat';
  240.      59 : ProductNames:='NetGate';
  241.      60 : ProductNames:='Odie';
  242.      61 : ProductNames:='Quick Gimme';
  243.      62 : ProductNames:='dbLink';
  244.      63 : ProductNames:='TosScan';
  245.      64 : ProductNames:='Beagle';
  246.      65 : ProductNames:='Igor';
  247.      66 : ProductNames:='TIMS';
  248.      67 : ProductNames:='Isis';
  249.      68 : ProductNames:='AirMail';
  250.      69 : ProductNames:='XRS';
  251.      70 : ProductNames:='Juliet';
  252.      71 : ProductNames:='Jabberwocky';
  253.      72 : ProductNames:='XST';
  254.      73 : ProductNames:='MailStorm';
  255.      74 : ProductNames:='BIX-Mail';
  256.      75 : ProductNames:='IMAIL';
  257.      76 : ProductNames:='FTNGate';
  258.      77 : ProductNames:='RealMail';
  259.      78 : ProductNames:='Lora-CBIS';
  260.      79 : ProductNames:='TDCS';
  261.      80 : ProductNames:='InterMail';
  262.      81 : ProductNames:='RFD';
  263.      82 : ProductNames:='Yuppie!';
  264.      83 : ProductNames:='EMMA';
  265.      84 : ProductNames:='QBoxMail';
  266.  85..86 : ProductNames:='Number '+CHR(Num-33);
  267.      87 : ProductNames:='GSBBS';
  268.      88 : ProductNames:='Merlin';
  269.      89 : ProductNames:='TPCS';
  270.      90 : ProductNames:='Raid';
  271.      91 : ProductNames:='Outpost';
  272.      92 : ProductNames:='Nizze';
  273.      93 : ProductNames:='Armadillo';
  274.      94 : ProductNames:='Rfmail';
  275.      95 : ProductNames:='Msgtoss';
  276.      96 : ProductNames:='InfoTex';
  277.      97 : ProductNames:='GEcho';
  278.      98 : ProductNames:='CDEhost';
  279.      99 : ProductNames:='Pktize';
  280.     100 : ProductNames:='PC-Rain';
  281.     101 : ProductNames:='Truffle';
  282.     102 : ProductNames:='Foozle';
  283.     103 : ProductNames:='White Pointer';
  284.     104 : ProductNames:='GateWorks';
  285.     105 : ProductNames:='Portal of Power';
  286.     106 : ProductNames:='MacWoof';
  287.     107 : ProductNames:='Mosaic';
  288.     108 : ProductNames:='TPBEcho';
  289.     109 : ProductNames:='HandyMail';
  290.     110 : ProductNames:='EchoSmith';
  291.     111 : ProductNames:='FileHost';
  292.     112 : ProductNames:='SFTS';
  293.     113 : ProductNames:='Benjamin';
  294.     114 : ProductNames:='RiBBS';
  295.     115 : ProductNames:='MP';
  296.     116 : ProductNames:='Ping';
  297.     117 : ProductNames:='Door2Europe';
  298.     118 : ProductNames:='SWIFT';
  299.     119 : ProductNames:='WMAIL';
  300.     120 : ProductNames:='RATS';
  301.     121 : ProductNames:='Harry the Dirty Dog';
  302.     122 : ProductNames:='Maximus-CBCS';
  303.     123 : ProductNames:='SwifEcho';
  304.     124 : ProductNames:='GCChost';
  305.     125 : ProductNames:='RPX-Mail';
  306.     126 : ProductNames:='Tosser';
  307.     127 : ProductNames:='TCL';
  308.     128 : ProductNames:='MsgTrack';
  309.     129 : ProductNames:='FMail';
  310.     130 : ProductNames:='Scantoss';
  311.     131 : ProductNames:='Point Manager';
  312.     133 : ProductNames:='Simplex';
  313.     134 : ProductNames:='UMTP';
  314.     135 : ProductNames:='Indaba';
  315.     136 : ProductNames:='Echomail Engine';
  316.     137 : ProductNames:='DragonMail';
  317.     138 : ProductNames:='Prox';
  318.     139 : ProductNames:='Tick';
  319.     140 : ProductNames:='RA-Echo';
  320.     141 : ProductNames:='TrapToss';
  321.     142 : ProductNames:='Babel';
  322.     143 : ProductNames:='UMS';
  323.     144 : ProductNames:='RWMail';
  324.     145 : ProductNames:='WildMail';
  325.     146 : ProductNames:='AlMAIL';
  326.     147 : ProductNames:='XCS';
  327.     148 : ProductNames:='Fone-Link';
  328.     149 : ProductNames:='Dogfight';
  329.     150 : ProductNames:='Ascan';
  330.     151 : ProductNames:='FastMail';
  331.     152 : ProductNames:='DoorMan';
  332.     153 : ProductNames:='PhaedoZap';
  333.     154 : ProductNames:='SCREAM';
  334.     155 : ProductNames:='MoonMail';
  335.     156 : ProductNames:='Backdoor';
  336.     157 : ProductNames:='MailLink';
  337.     158 : ProductNames:='Mail Manager';
  338.     159 : ProductNames:='Black Star';
  339.     160 : ProductNames:='Bermuda';
  340.     161 : ProductNames:='PT';
  341.     162 : ProductNames:='UltiMail';
  342.     163 : ProductNames:='GMD';
  343.     164 : ProductNames:='FreeMail';
  344.     165 : ProductNames:='Meliora';
  345.     166 : ProductNames:='Foodo';
  346.     167 : ProductNames:='MSBBS';
  347.     168 : ProductNames:='Boston BBS';
  348.     169 : ProductNames:='XenoMail';
  349.     170 : ProductNames:='XenoLink';
  350.     171 : ProductNames:='ObjectMatrix';
  351.     172 : ProductNames:='Milquetoast';
  352.     173 : ProductNames:='PipBase';
  353.     174 : ProductNames:='EzyMail';
  354.     175 : ProductNames:='FastEcho';
  355.     176 : ProductNames:='IOS';
  356.     177 : ProductNames:='Communique';
  357.     178 : ProductNames:='PointMail';
  358.     179 : ProductNames:='Harvey''s Robot';
  359.     180 : ProductNames:='2daPoint';
  360.     181 : ProductNames:='CommLink';
  361.     182 : ProductNames:='fronttoss';
  362.     183 : ProductNames:='SysopPoint';
  363.     184 : ProductNames:='PTMAIL';
  364.     185 : ProductNames:='AECHO';
  365.     186 : ProductNames:='DLGMail';
  366.     187 : ProductNames:='GatePrep';
  367.     188 : ProductNames:='Spoint';
  368.     189 : ProductNames:='TurboMail';
  369.     190 : ProductNames:='FXMAIL';
  370.     191 : ProductNames:='NextBBS';
  371.     192 : ProductNames:='EchoToss';
  372.     193 : ProductNames:='SilverBox';
  373.     194 : ProductNames:='MBMail';
  374.     195 : ProductNames:='SkyFreq';
  375.     196 : ProductNames:='ProMailer';
  376.     197 : ProductNames:='Mega Mail';
  377.     198 : ProductNames:='YaBom';
  378.     199 : ProductNames:='TachEcho';
  379.     200 : ProductNames:='XAP';
  380.     201 : ProductNames:='EZMAIL';
  381.     202 : ProductNames:='Arc-Binkley';
  382.     203 : ProductNames:='Roser';
  383.     204 : ProductNames:='UU2';
  384.     205 : ProductNames:='NMS';
  385.     206 : ProductNames:='BBCSCAN';
  386.     207 : ProductNames:='XBBS';
  387.     208 : ProductNames:='LoTek Vzrul';
  388.     209 : ProductNames:='Private Point';
  389.     210 : ProductNames:='NoSnail';
  390.     211 : ProductNames:='SmlNet';
  391.     212 : ProductNames:='STIR';
  392.     213 : ProductNames:='RiscBBS';
  393.     214 : ProductNames:='Hercules';
  394.     215 : ProductNames:='AMPRGATE';
  395.     216 : ProductNames:='BinkEMSI';
  396.     217 : ProductNames:='EditMsg';
  397.     218 : ProductNames:='Roof';
  398.     219 : ProductNames:='QwkPkt';
  399.     220 : ProductNames:='MARISCAN';
  400.     221 : ProductNames:='NewsFlash';
  401.     222 : ProductNames:='Paradise';
  402.     223 : ProductNames:='DogMatic-ACB';
  403.     224 : ProductNames:='T-Mail';
  404.     225 : ProductNames:='JetMail';
  405.     226 : ProductNames:='MainDoor';
  406.     ELSE  ProductNames:='Unknown system ('+HexW(Num)+')';
  407.     END;
  408.   END;
  409.  
  410.   FUNCTION NoAll(CONST Adr: TFidoAddress): BOOLEAN;
  411.   BEGIN
  412.     WITH Adr DO
  413.       NoAll:=(Zone<>-1) AND (Net<>-1) AND (Node<>-1) AND (Point<>-1);
  414.   END;
  415.  
  416.   FUNCTION Address2Sort(CONST Address: TFidoAddress): S8;
  417.   BEGIN
  418.     WITH Address DO
  419.       Address2Sort:=Char(Hi(Zone))+Char(Lo(Zone))+Char(Hi(Net))+Char(Lo(Net))+
  420.                     Char(Hi(Node))+Char(Lo(Node))+Char(Hi(Point))+Char(Lo(Point));
  421.   END;
  422.  
  423.   PROCEDURE RemapAddress(VAR Adr: TFidoAddress);
  424.   LABEL
  425.     Again;
  426.   VAR
  427.     OrigPoint : Integer;
  428.  
  429.     PROCEDURE ComputeMaxRequest;
  430.     BEGIN
  431.       IF FoundInNl OR FoundInNodes THEN
  432.       BEGIN
  433.         IF (NodelistEntry.Password='') AND (NodesRec.SessionPwd='') THEN
  434.         BEGIN
  435.           GlobNodeStat:=nsKnown;
  436.         END ELSE
  437.         BEGIN
  438.           GlobNodeStat:=nsPassword;
  439.         END;
  440.       END ELSE
  441.       BEGIN
  442.         GlobNodeStat:=nsUnKnown;
  443.       END;
  444.       MaxReqFiles:=Cfg.Request.Limit[GlobNodeStat,rlPrCall].MaxFiles;
  445.       MaxReqBytes:=Cfg.Request.Limit[GlobNodeStat,rlPrCall].MaxBytes;
  446.       IF MaxReqBytes=0 THEN MaxReqBytes:=MaxLongInt;
  447.       MaxReqTime:=Cfg.Request.Limit[GlobNodeStat,rlPrCall].MaxTime;
  448.       IF MaxReqTime=0 THEN MaxReqTime:=MaxTime;
  449.  
  450.       FindSuckerInfo(Adr, DRI);
  451.       WITH Cfg.Request.Limit[GlobNodeStat,rlPrDay] DO
  452.       BEGIN
  453.         IF (MaxFiles>0) AND (MaxReqFiles>MaxFiles-DRI.NumFiles) THEN MaxReqFiles:=MaxFiles-DRI.NumFiles;
  454.         IF (MaxBytes>0) AND (MaxReqBytes>MaxBytes-DRI.NumBytes) THEN MaxReqBytes:=MaxBytes-DRI.NumBytes;
  455.         IF (MaxTime>0) AND (MaxReqTime>MaxTime-DRI.UsedTime) THEN MaxReqTime:=MaxTime-DRI.UsedTime;
  456.       END;
  457.     END;
  458.  
  459.   BEGIN
  460.     FoundInNl:=False; FoundInNodes:=False;
  461.     IF (Cfg.Addresses[Cfg.MainAdrNum].Point=0) AND (Cfg.PointNet<>0) AND (Cfg.UseFakeAddress) THEN
  462.     BEGIN
  463.       { Remap egne 4D points til 3D }
  464.       IF (Adr.Zone=Cfg.Addresses[Cfg.MainAdrNum].Zone) AND
  465.          (Adr.Net=Cfg.Addresses[Cfg.MainAdrNum].Net) AND
  466.          (Adr.Node=Cfg.Addresses[Cfg.MainAdrNum].Node) AND
  467.          (Adr.Point<>0) THEN
  468.       BEGIN
  469.         Adr.Net:=Cfg.PointNet;
  470.         Adr.Node:=Adr.Point;
  471.         Adr.Point:=0;
  472.       END;
  473.     END ELSE
  474.     BEGIN
  475.       { Remap egne 3D points til 4D }
  476.       IF (Adr.Zone=Cfg.Addresses[Cfg.MainAdrNum].Zone) AND
  477.          (Adr.Net=Cfg.Pointnet) And (Adr.Point=0) THEN
  478.       BEGIN
  479.         Adr.Point:=Adr.Node;
  480.         Adr.Net:=Cfg.Addresses[Cfg.MainAdrNum].Net;
  481.         Adr.Node:=Cfg.Addresses[Cfg.MainAdrNum].Node;
  482.       END;
  483.     END;
  484.     OrigPoint:=Adr.Point;
  485. Again:
  486.     IF FindNode(Adr,NodelistEntry) THEN
  487.     BEGIN
  488.       FoundInNl:=True;
  489.     END ELSE
  490.     BEGIN
  491.       IF (Adr.Point=0) And (FindPointNet(NodesRec,Adr.Net)) THEN
  492.       BEGIN
  493.         Adr.Point:=Adr.Node;
  494.         Adr.Net:=NodesRec.Address.Net;
  495.         Adr.Node:=NodesRec.Address.Node;
  496.         IF FindNode(Adr,NodelistEntry) THEN FoundInNl:=True;
  497.       END;
  498.     END;
  499.     IF FindNodeInfo(NodesRec,Adr) THEN
  500.       FoundInNodes:=True
  501.     ELSE
  502.       IF NOT FoundInNL AND (Adr.Point<>0) THEN
  503.       BEGIN
  504.         Adr.Point:=0;
  505.         GOTO Again;
  506.       END;
  507.     ComputeMaxRequest;
  508.     Adr.Point:=OrigPoint;
  509.   END;
  510.  
  511.   FUNCTION CmpAdr(CONST a1, a2: TFidoAddress): Boolean;
  512.   BEGIN
  513.     CmpAdr:=(a1.Zone=a2.Zone) And (a1.Net=a2.Net) And (a1.Node=a2.Node) And (a1.Point=a2.Point);
  514.   END;
  515.  
  516.   FUNCTION GetAdressFromStr(s: String; VAR Address: TFidoAddress): BOOLEAN;
  517.   VAR
  518.     test,i:INTEGER;
  519.   BEGIN
  520.     GetAdressFromStr:=FALSE;
  521.     FILLCHAR(Address,SizeOf(TFidoAddress),0);
  522.     i:=POS('@',s);
  523.     IF i>0 THEN s:=COPY(s,1,i-1);
  524.     Replace(s,' ','',0);
  525.     i:=POS(':',s);
  526.     IF i=0 THEN Address.Zone:=Cfg.Addresses[Cfg.MainAdrNum].Zone ELSE
  527.     BEGIN
  528.       VAL(COPY(s,1,i-1),Address.Zone,test);
  529.       IF test>0 THEN EXIT;
  530.       DELETE(s,1,i);
  531.     END;
  532.     i:=POS('/',s);
  533.     IF i=0 THEN Address.Net:=Cfg.Addresses[Cfg.MainAdrNum].Net ELSE
  534.     BEGIN
  535.       VAL(COPY(s,1,i-1),Address.Net,test);
  536.       IF test>0 THEN EXIT;
  537.       DELETE(s,1,i);
  538.     END;
  539.     i:=POS('.',s);
  540.     IF i=0 THEN
  541.     BEGIN
  542.       VAL(s,Address.Node,test);
  543.       s:='';
  544.     END ELSE
  545.     BEGIN
  546.       VAL(COPY(s,1,i-1),Address.Node,Test);
  547.       DELETE(s,1,i);
  548.     END;
  549.     IF test>0 THEN EXIT;
  550.     VAL(s,Address.Point,Test);
  551.     IF Test<>0 THEN Address.point:=0;
  552.     GetAdressFromStr:=TRUE;
  553.   END;
  554.  
  555.  
  556. {--- PORTAL.UDF managment routines ------------------------------------------}
  557.  
  558.   PROCEDURE FindUnDialable(CONST InAddress: TFidoAddress; VAR NC, BWZ : Word);
  559.   VAR
  560.     Found         : Boolean;
  561.     UnDialable    : PSimpDB;
  562.     UnDialableRec : TUndialable;
  563.   BEGIN
  564.     Found:=False;
  565.     New(Undialable, Open(StartPath+PoPUndialFileName, SizeOf(TUndialable), False));
  566.     IF Undialable<>Nil THEN
  567.     BEGIN
  568.       WHILE NOT Found AND UnDialable^.NextRec(UnDialableRec, NoKeep) DO
  569.       BEGIN
  570.         Found:=CmpAdr(InAddress,UnDialableRec.Address);
  571.       END;
  572.       Dispose(UnDialable, Close);
  573.     END;
  574.     IF Found THEN
  575.     BEGIN
  576.       NC:=UnDialableRec.NoConnect;
  577.       BWZ:=UnDialableRec.BadWaZOO;
  578.     END ELSE
  579.     BEGIN
  580.       NC:=0;
  581.       BWZ:=0;
  582.     END;
  583.   END;
  584.  
  585.   PROCEDURE RemoveUnDialable(CONST InAddress: TFidoAddress);
  586.   VAR
  587.     Found      : Boolean;
  588.     UnDial     : PSimpDB;
  589.     UnDialRec  : TUndialable;
  590.   BEGIN
  591.     New(Undial, Open(StartPath+PoPUndialFileName, SizeOf(TUndialable), False));
  592.     IF Undial<>Nil THEN
  593.     BEGIN
  594.       Found:=False;
  595.       WHILE NOT Found AND UnDial^.NextRec(UndialRec, Keep) DO
  596.       BEGIN
  597.         IF CmpAdr(InAddress, UnDialRec.Address) THEN
  598.         BEGIN
  599.           UnDial^.DelRec(UndialRec, UnDial^.FilePos-1);
  600.           Found:=True
  601.         END ELSE
  602.           UnDial^.Unlock(UnDial^.FilePos-1);
  603.       END;
  604.       Dispose(UnDial, Close);
  605.     END;
  606.   END;
  607.  
  608.   PROCEDURE UpdateUnDialable;
  609.   VAR
  610.     Found      : Boolean;
  611.     UnDial     : PSimpDB;
  612.     UnDialRec  : TUndialable;
  613.   BEGIN
  614.     New(Undial, Open(StartPath+PoPUndialFileName, SizeOf(TUndialable), True));
  615.     IF Undial<>NIL THEN
  616.     BEGIN
  617.       Found:=False;
  618.       WHILE NOT Found AND Undial^.NextRec(UndialRec, Keep) DO
  619.       BEGIN
  620.         IF CmpAdr(InAddress,UnDialRec.Address) THEN
  621.           Found:=True
  622.         ELSE
  623.           UnDial^.Unlock(UnDial^.FilePos-1);
  624.       END;
  625.       IF NOT Found THEN FillChar(UnDialRec, SizeOf(UnDialRec), 0);
  626.       WITH UnDialRec DO
  627.       BEGIN
  628.         Address:=InAddress;
  629.         NoConnect:=NoConnect+NC;
  630.         BadWaZOO:=BadWaZOO+BWZ;
  631.       END;
  632.       IF Found THEN
  633.         Undial^.PutRec(UnDialRec, UnDial^.FilePos-1)
  634.       ELSE
  635.         Undial^.AddRec(UnDialRec);
  636.       Dispose(UnDial, Close);
  637.     END ELSE
  638.       AddLog('!', 'Not enough memory to open: '+PoPUndialFileName);
  639.   END;
  640.  
  641.  
  642. {=== PORTAL.NOD managment routines ===}
  643.  
  644. TYPE
  645.   TNodesIdx = RECORD
  646.     NumRecs  : Word;
  647.     FileTime : LongInt;
  648.     RecInfo  : ARRAY[0..5000] OF RECORD
  649.       Adr      : TFidoAddress;
  650.       PointNet : Integer;
  651.     END;
  652.   END;
  653.  
  654.   PROCEDURE DisposeNodesIdx;
  655.   BEGIN
  656.     IF NodesIdx<>NIL THEN
  657.       FreeMemCheck(NodesIdx, 6+TNodesIdx(NodesIdx^).NumRecs*10{SizeOf(TNodesIdx.RecInfo[0])});
  658.   END;
  659.  
  660.   PROCEDURE CheckForReReadNodes(Forced: Boolean);
  661.   VAR
  662.     f      : TNetFile;
  663.     n      : TNodeInfo;
  664.     ReadIt : Boolean;
  665.     Sr     : SearchRec;
  666.   BEGIN
  667.     ReadIt:=(NodesIdx=NIL) OR Forced;
  668.     IF NOT ReadIt THEN
  669.     BEGIN
  670.       FindFirst(StartPath+PoPNodesFileName, Archive, Sr);
  671.       FindClose(Sr);
  672.       ReadIt:=Sr.Time<>TNodesIdx(NodesIdx^).FileTime;
  673.     END;
  674.     IF ReadIt THEN
  675.     BEGIN
  676.       DisposeNodesIdx;
  677.       IF f.Open(StartPath+PoPNodesFileName, SizeOf(TNodeInfo), False) THEN
  678.       BEGIN
  679.         IF f.FileSize>0 THEN
  680.         BEGIN
  681. {
  682. addlog('*','Reading nodes...');
  683. }
  684.           GetMem(NodesIdx, 6+f.FileSize*10{SizeOf(TNodesIdx.RecInfo[0])});
  685.           TNodesIdx(NodesIdx^).NumRecs:=f.FileSize;
  686.           GetFTime(f, TNodesIdx(NodesIdx^).FileTime);
  687.           WHILE NOT f.EoF DO
  688.           BEGIN
  689.             f.Read(n, NoKeep, Wait);
  690.             IF (f.IOResult=0) THEN
  691.             BEGIN
  692.               TNodesIdx(NodesIdx^).RecInfo[f.FilePos-1].Adr:=n.Address;
  693.               TNodesIdx(NodesIdx^).RecInfo[f.FilePos-1].PointNet:=n.PointNet;
  694.             END;
  695.           END;
  696.         END;
  697.         f.Close;
  698.       END;
  699.     END;
  700.   END;
  701.  
  702.   FUNCTION FindNodeInIdx(VAR Num: Word; CONST Adr: TFidoAddress): Boolean;
  703.   BEGIN
  704.     IF NodesIdx<>NIL THEN
  705.     BEGIN
  706.       Num:=0;
  707.       WHILE (Num<TNodesIdx(NodesIdx^).NumRecs) AND NOT CmpAdr(Adr, TNodesIdx(NodesIdx^).RecInfo[Num].Adr) DO
  708.         Inc(Num);
  709.       FindNodeInIdx:=(Num<TNodesIdx(NodesIdx^).NumRecs);
  710.     END ELSE
  711.       FindNodeInIdx:=False;
  712.   END;
  713.  
  714.   FUNCTION FindPointNetInIdx(VAR Num: Word; PNet: Integer): Boolean;
  715.   BEGIN
  716.     IF NodesIdx<>NIL THEN
  717.     BEGIN
  718.       Num:=0;
  719.       WHILE (Num<TNodesIdx(NodesIdx^).NumRecs) AND (PNet<>TNodesIdx(NodesIdx^).RecInfo[Num].PointNet) DO
  720.         Inc(Num);
  721.       FindPointNetInIdx:=(Num<TNodesIdx(NodesIdx^).NumRecs);
  722.     END ELSE
  723.       FindPointNetInIdx:=False;
  724.   END;
  725.  
  726.   FUNCTION FindNodeInfo(VAR n: TNodeInfo; CONST Address: TFidoAddress): Boolean;
  727.   LABEL
  728.     TryAgain;
  729.   VAR
  730.     f     : TNetFile;
  731.     Num   : Word;
  732.   BEGIN
  733.     CheckForReReadNodes(False);
  734. TryAgain:
  735.     IF NOT FindNodeInIdx(Num, Address) THEN
  736.     BEGIN
  737.       _NodesInit(n);
  738. {      FillChar(n, SizeOf(n), 0);}
  739.     END ELSE
  740.     BEGIN
  741.       IF f.Open(StartPath+PoPNodesFileName, SizeOf(TNodeInfo), False) THEN
  742.       BEGIN
  743.         f.GetRec(n, Num, NoKeep, Wait);
  744.         f.Close;
  745.         IF NOT CmpAdr(n.Address, Address) THEN  { Something has invalidated the index - reread it! }
  746.         BEGIN
  747.           CheckForReReadNodes(True);
  748.           GOTO TryAgain;
  749.         END;
  750.       END;
  751.     END;
  752.     FindNodeInfo:=(NodesIdx<>NIL) AND (Num<TNodesIdx(NodesIdx^).NumRecs);
  753.   END;
  754.  
  755.   PROCEDURE PutNodeInfo(VAR n: TNodeInfo);
  756.   LABEL
  757.     TryAgain;
  758.   VAR
  759.     f     : TNetFile;
  760.     Found : Boolean;
  761.     o     : TNodeInfo;
  762.     Num   : Word;
  763.   BEGIN
  764.     CheckForReReadNodes(False);
  765. TryAgain:
  766.     Found:=FindNodeInIdx(Num, n.Address);
  767.     f.Open(StartPath+PoPNodesFileName, SizeOf(TNodeInfo), True) ;
  768.     IF Found THEN
  769.     BEGIN
  770.       f.GetRec(o, Num, Keep, Wait);
  771.       IF NOT CmpAdr(o.Address, n.Address) THEN  { Something has invalidated the index - reread it! }
  772.       BEGIN
  773.         f.Unlock(f.FilePos-1);
  774.         f.Close;
  775.         CheckForReReadNodes(True);
  776.         GOTO TryAgain;
  777.       END;
  778.     END ELSE
  779.       f.Seek(f.FileSize);
  780.     f.PutRec(n, Num);
  781.     f.Close;
  782.   END;
  783.  
  784.   FUNCTION FindPointNet(VAR n: TNodeInfo; InPointNet: Integer): Boolean;
  785.   LABEL
  786.     TryAgain;
  787.   VAR
  788.     f     : TNetFile;
  789.     Found : Boolean;
  790.     Num   : Word;
  791.   BEGIN
  792.     CheckForReReadNodes(False);
  793.  
  794.     Found:=False;
  795.     IF InPointNet<>0 THEN
  796.     BEGIN
  797. TryAgain:
  798.       Found:=FindPointNetInIdx(Num, InPointNet);
  799.       IF Found THEN
  800.       BEGIN
  801.         f.Open(StartPath+PoPNodesFileName, SizeOf(TNodeInfo), False);
  802.         f.GetRec(n, Num, NoKeep, Wait);
  803.         f.Close;
  804.         IF (InPointNet<>n.PointNet) THEN
  805.         BEGIN
  806.           CheckForReReadNodes(True);
  807.           GOTO TryAgain;
  808.         END;
  809.       END;
  810.     END;
  811.     IF NOT Found THEN _NodesInit(n);
  812.     FindPointNet:=Found;
  813.   END;
  814.  
  815. {--- Outbound path managment ------------------------------------------------}
  816.  
  817.   FUNCTION HoldAreaNameMunge(Zone: Integer; Create: Boolean) : PathStr;
  818.   VAR
  819.     s : PathStr;
  820.   BEGIN
  821.     s:=ReplaceEnv(Cfg.Outbound);
  822.     IF Zone<>Cfg.Addresses[Cfg.MainAdrNum].Zone THEN s:=s+'.'+Copy(HexW(Zone),2,3);
  823.     IF NOT ChkDir(s) AND Create THEN MakeFullDir(s);
  824.     HoldAreaNameMunge:=AddBackSlash(s);
  825.   END;
  826.  
  827.   FUNCTION HoldAreaPath(CONST Adr: TFidoAddress; Create: Boolean): PathStr;
  828.   VAR
  829.     s : PathStr;
  830.   BEGIN
  831.     s:=HoldAreaNameMunge(Adr.Zone,Create);
  832.     IF Adr.Point<>0 THEN
  833.     BEGIN
  834.       s:=s+Address(Adr.Net,Adr.Node)+'.PNT';
  835.       IF NOT ChkDir(s) AND Create THEN MakeFullDir(s);
  836.     END;
  837.     HoldAreaPath:=AddBackSlash(s);
  838.   END;
  839.  
  840.   FUNCTION HoldFileName(CONST Adr: TFidoAddress; Create: Boolean): PathStr;
  841.   VAR
  842.     s: PathStr;
  843.   BEGIN
  844.     s:=HoldAreaPath(Adr,Create);
  845.     IF Adr.Point<>0 THEN
  846.     BEGIN
  847.       s:=s+Address(0,Adr.Point);
  848.     END ELSE
  849.     BEGIN
  850.       s:=s+Address(Adr.Net,Adr.Node);
  851.     END;
  852.     HoldFileName:=s+'.';
  853.   END;
  854.  
  855.   FUNCTION InventPktName: PathStr;
  856.   VAR
  857.     Hour, Min, Sec, Sec100: Word;
  858.   BEGIN
  859.     GetTime(Hour, Min, Sec, Sec100);
  860.     InventPktName:=Copy(HexW(Hour),3,2)+Copy(HexW(Min),3,2)+
  861.                    Copy(HexW(Sec),3,2)+Copy(HexW(Sec100),3,2)+'.PKT';
  862.   END;
  863.  
  864.   FUNCTION  MakeReqFileName(Net, Node: Integer; NodeStat: TNodeStat): PathStr;
  865.   BEGIN
  866.     MakeReqFileName:=ReplaceEnv(Cfg.Inbound[NodeStat])+HexW(Net)+HexW(Node)+'.R'+HexB(Cfg.TaskNumber);
  867.   END;
  868.  
  869.   FUNCTION MarkNodeBusy(VAR f: File; CONST Adr: TFidoAddress): Boolean;
  870.   VAR
  871.     Sr    : SearchRec;
  872.     FName : PathStr;
  873.     IORes : Integer;
  874.   BEGIN
  875.     IF Cfg.TaskNumber>0 THEN
  876.     BEGIN
  877.       IORes:=IOResult;
  878.       IF IORes<>0 THEN AddLog('!','I/O error before creating busy flag ('+Long2Str(IORes)+')');
  879.       FName:=HoldFileName(Adr, False)+'BSY';
  880.       FindFirst(FName, AnyFile, Sr);
  881.       IF DOSError=18 THEN   { No more files }
  882.       BEGIN
  883.         Assign(f, FName);
  884.         ReWrite(f);
  885.         MarkNodeBusy:=(IOResult=0);
  886.       END ELSE
  887.       BEGIN
  888.         MarkNodeBusy:=(DOSError=3);  { Path not found }
  889.       END;
  890.       FindClose(Sr);
  891.     END ELSE
  892.       MarkNodeBusy:=True;
  893.   END;
  894.  
  895.   PROCEDURE UnMarkNodeBusy(VAR f: File);
  896.   VAR
  897.     i : Integer;
  898.   BEGIN
  899.     IF Cfg.TaskNumber>0 THEN
  900.     BEGIN
  901.       i:=IOResult;
  902.       IF i<>0 THEN AddLog('!','I/O error before removing busy flag ('+Long2Str(i)+')');
  903.       Close(f);
  904.       i:=IOResult;
  905.       IF i=0 THEN
  906.       BEGIN
  907.         Erase(f);
  908.         i:=IOResult;
  909.       END;
  910.       { 103 pga. at ikke existerende zone outbounds ikke oprettes }
  911.       IF NOT (i IN [0, 103]) THEN AddLog('!','Error removing busy flag ('+Long2Str(i)+')');
  912.     END;
  913.   END;
  914.  
  915.   PROCEDURE FindSuckerInfo(CONST Adr: TFidoAddress; VAR DRI: TDailyReqInfo);
  916.   VAR
  917.     f : TNetFile;
  918.     Found : Boolean;
  919.   BEGIN
  920.     Found:=False;
  921.     IF f.Open(StartPath+PoPDailyReqInfoFileName, SizeOf(TDailyReqInfo), False) THEN
  922.     BEGIN
  923.       REPEAT
  924.         f.Read(DRI, NoKeep, Wait);
  925.         Found:=CmpAdr(Adr, DRI.Address);
  926.       UNTIL Found OR f.EoF;
  927.       f.Close;
  928.     END;
  929.     IF NOT Found THEN
  930.     BEGIN
  931.       FillChar(DRI, SizeOf(DRI), 0);
  932.       DRI.Address:=Adr;
  933.     END;
  934.   END;
  935.  
  936.   PROCEDURE WriteSuckerInfo(DRI: TDailyReqInfo);
  937.   VAR
  938.     TmpDRI : TDailyReqInfo;
  939.     f      : TNetFile;
  940.     Found  : Boolean;
  941.   BEGIN
  942.     IF f.Open(StartPath+PoPDailyReqInfoFileName, SizeOf(TDailyReqInfo), True) THEN
  943.     BEGIN
  944.       Found:=False;
  945.       WHILE NOT f.EoF AND NOT Found DO
  946.       BEGIN
  947.         f.Read(TmpDRI, Keep, Wait);
  948.         IF CmpAdr(TmpDRI.Address, DRI.Address) THEN Found:=True ELSE f.UnLock(f.FilePos-1);
  949.       END;
  950.       IF Found THEN f.Seek(f.FilePos-1);
  951.       f.Write(DRI);
  952.       f.Close;
  953.     END;
  954.   END;
  955.  
  956.  
  957. END.
  958.